module Eval
( eval
) where
import MyData.Form
import ReadIndentedLisp

veval env f = snd $ eval env f
eval :: Eval S
eval env a@(A s) = -- eval atom
  case assoc env a of --TODO handle '.' for OOP
       Nothing -> (env,a)
       Just va -> (env,va)
eval env c@(C a@(A ":") (C fargs (C rargs (A "")))) = let env'=bindArg env fargs $ veval env rargs in (env',nil) -- eval for side effect to save parens
eval env c@(C a@(A s) rargs@(C _ _)) = -- eval nvt
  case veval env a of
       lab@(C (A nvt) (C fargs fbody@(C _ _))) -> handleNVT lab nvt fargs fbody rargs env
       _ -> (env,c)
eval env f = (env,f) -- fallback

bindArg env fa ra = bind ((==""),env) (fa,ra)

handleNVT lab nvt fa fb ra env =
  let funNVT = head nvt
      argNVT = cycle $ tail nvt
      ra' = applyNVT (veval env) argNVT ra
      labRetval = label (eval,bindArg) (env,lab,nil,fa,fb,ra')
      in applyFunNVT env funNVT labRetval

applyFunNVT env 'n' f = (env,f)
applyFunNVT env 'v' f = eval env f -- env may be modified here!
applyFunNVT env 't' f = (env,typeOf $ veval env f)
applyFunNVT env ',' f = (env, f >>= applyComma (veval env))
applyFunNVT env 'e' f = error $ "(debuging) exit: "++pr f
applyFunNVT env 'b' f = let vf=veval env f in (env,if vf/=nil then vf else error $ "(asserted) boolean test fails!")

applyNVT :: (F S->F S) -> S -> F S -> F S
applyNVT ve _ (A _) = nil
applyNVT ve nvt ra@(C _ _) = let (l',nvt',ra')=applyNVT1 ve nvt ra in l' `C` applyNVT ve nvt' ra'

applyNVT1 :: (F S->F S) -> S -> F S -> (F S,S,F S)
applyNVT1 ve nvt (A _) = (nil,nvt,nil)
applyNVT1 ve ('n':rest) (C x y) = (x,rest,y)
applyNVT1 ve ('v':rest) (C x y) = (ve x,rest,y)
applyNVT1 ve ('t':rest) (C x y) = (typeOf $ ve x,rest,y)
applyNVT1 ve ('e':rest) (C x y) = let vx=ve x;([te,th,el],rest',y')=applyNVTn 3 ve rest y in (if vx==te then th else el,rest',y')
applyNVT1 ve ('b':rest) (C x y) = let vx=ve x;([th,el],rest',y')=applyNVTn 2 ve rest y in (if vx/=nil then th else el,rest',y')
applyNVT1 ve (',':rest) (C x y) = (ve x>>=applyComma ve,rest,y)

applyNVTn :: Integer -> (F S->F S) -> S -> F S -> ([F S],S,F S)
applyNVTn 0 ve nvt ra = ([],nvt,ra)
applyNVTn n ve nvt ra = let (l',nvt',ra')=applyNVT1 ve nvt ra; (l'',nvt'',ra'')=applyNVTn (n-1) ve nvt' ra'; in (l':l'',nvt'',ra'')

test = pr . prog eval nil . ril
